﻿'// ========================================================================= '
'// ------------------------------------------------------------------------- '
'//!				\file		XLW.vb
'			        \date		june 2010
'			        \author		TNick
'
'			        \brief		
'
'
'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   This file is considered universal knowledge. No restrictions
'   are imposed; use as you see fit.
'   Please read ReadMe.txt and Licence.txt in root folder
'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'   This code wraps the excel com interface. This way, with two versions of 
'  this dll we can have unique calls in main application
'// ------------------------------------------------------------------------- '
'// ========================================================================= '
'//
'//
'//
'//
'//  IMPORTS     ------------------------------------------------------------ '


Imports System
Imports Microsoft.Win32
#If EMPTY_STUB = false
Imports Microsoft.Office.Interop
#End If

'//  IMPORTS     ============================================================ '
'//
'//
'//
'//
'//  DEFINITIONS    --------------------------------------------------------- '

'//  DEFINITIONS    ========================================================= '
'//
'//
'//
'//
'//  DATA    ---------------------------------------------------------------- '


'//  DATA    ================================================================ '
'//
'//
'//
'//
'//  CLASS    --------------------------------------------------------------- '

Public NotInheritable Class XLS

    Public Enum LAYCELL
        ONECELL = 0
        MERGED
        HEAD
    End Enum

    Public Structure LAYMRGD
        Dim a As string
        Dim r1 As Integer
        Dim r2 As Integer
        Dim c1 As Integer
        Dim c2 As Integer
    End Structure

    Public Enum ALGN
        TOPLEFT
        TOPCENTER
        TOPRIGHT
        MIDDLELEFT
        MIDDLECENTER
        MIDDLERIGHT
        BTMLEFT
        BTMCENTER
        BTMRIGHT
    End Enum

    Public Structure LAY
        Dim iRowStart As Integer
        Dim iColStart As Integer
        Dim iRowCnt As Integer
        Dim iColCnr As Integer
        Dim cLay() As LAYCELL 
        Dim aAlgn() As ALGN 
        Dim dTxH() As double 
        Dim dWidths() as double
        Dim dHeights() as double
        Dim aMrg() as LAYMRGD
    End Structure


    Public Enum ERR
        OK = 0  '// no error
        EXCEPTION
        BADINIT    '// objects are not in expected state
    End Enum

    '// --------------------------------------------------------------------- '
    '// DATA

    '// is used to hold status informations
    Dim eErrSts As ERR = ERR.OK


    '// links back to father workbook
    Private wb As XLW = Nothing
    #If EMPTY_STUB=false
    '// this is the one that we're wrapping here
    Private ExcelSheet As Excel.Worksheet
    #End If
    '// ===================================================================== '






            'sData.ExcelSheet = DirectCast(sData.ExcelWorkbook.ActiveSheet, _
            '                    Excel.Worksheet)



    '// --------------------------------------------------------------------- '
    '// QUERRIES
    Public ReadOnly Property ErrSts As ERR
        Get
            Return eErrSts
        End Get
    End Property
    '// ===================================================================== '


    '// --------------------------------------------------------------------- '
    '// an instance of this class needs to be created for each workbook
    '// may either create a new worksheet or open an existing one
    Public Sub New(ByRef wks As XLW, _
                   Byval Optional index As Integer = Integer.MaxValue)

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
    #Else
        Try
            wb = wks
            If (wb is Nothing) then
                eErrSts = ERR.BADINIT
                Exit Try
            End If


            If index = Integer.MaxValue Then
                ExcelSheet = DirectCast(wb.WB.ActiveSheet, _
                                    Excel.Worksheet)
            Else
                ExcelSheet = DirectCast(wb.WB.Sheets(index), _
                                    Excel.Worksheet)
            End If
            If (ExcelSheet Is Nothing) then
                eErrSts = ERR.BADINIT
                Exit Try
            End If
            

        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
        End Try

    #End If
    End Sub
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
    Public Function GetCV( _
        ByVal r As Integer, _
        ByVal c As Integer) _
        As Object

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return Nothing
    #Else
        Dim oRet As Object = Nothing
        Try
            If (ExcelSheet Is Nothing) Then
                eErrSts = ERR.BADINIT
                Exit Try
            End If
            With    DirectCast(ExcelSheet.Cells _
                (r, c),Excel.Range)
                If Not (.Value Is Nothing) Then
                    oRet = .Value
                End If
            End With
        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
        End Try
        Return oRet
    #Endif
    End Function
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
    Public Sub SetCV( _
        ByVal r As Integer, _
        ByVal c As Integer, _
        ByVal val As Object) _

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return
    #Else
        Try
            If (ExcelSheet Is Nothing) Then
                eErrSts = ERR.BADINIT
                Exit Try
            End If
            With    DirectCast(ExcelSheet.Cells _
                (r, c),Excel.Range)
                .Value = val
            End With
        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
        End Try
    #End If
    End Sub
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
    Public Function GetCVStr( _
        ByVal r As Integer, _
        ByVal c As Integer) _
        As String

		Debug.Print("GetCVStr")
    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return Nothing
    #Else
        Dim oRet As String = ""
        Try
			Debug.Print("ExcelSheet...")
            If (ExcelSheet Is Nothing) Then
                eErrSts = ERR.BADINIT
                Exit Try
            End If
			Debug.Print(".. ok")
            With    DirectCast(ExcelSheet.Cells _
                (r, c),Excel.Range)
				Debug.Print("With ok")
                If Not (.Value Is Nothing) Then
					Debug.Print("Not (.Value Is Nothing)")
                    oRet = Cstr(.Value)
					Debug.Print("String ok: <" & oRet & ">")
                End If
            End With
        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
        End Try
        Return oRet
    #End If
    End Function
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
    Public Function GetCVDbl( _
        ByVal r As Integer, _
        ByVal c As Integer, _
        ByRef bOK As Boolean) _
        As Double

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return 0
    #Else
        Dim oRet As Double = 0
        Try
            If (ExcelSheet Is Nothing) Then
                bOK = False
                eErrSts = ERR.BADINIT
                Exit Try
            End If
            With    DirectCast(ExcelSheet.Cells _
                (r, c),Excel.Range)
                If Not (.Value Is Nothing) Then
                    oRet = Cdbl(.Value)
                Else
                    bOK = False
                End If
            End With
        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
            bOK = False
        End Try
        Return oRet
    #End If
    End Function
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
    Public Function GetCVInt( _
        ByVal r As Integer, _
        ByVal c As Integer, _
        ByRef bOK As Boolean) _
        As Integer

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return 0
    #Else
        Dim oRet As Integer = 0
        Try
            If (ExcelSheet Is Nothing) Then
                bOK = False
                eErrSts = ERR.BADINIT
                Exit Try
            End If
            With    DirectCast(ExcelSheet.Cells _
                (r, c),Excel.Range)
                If Not (.Value Is Nothing) Then
                    oRet = Cint(.Value)
                Else
                    bOK = False
                End If
            End With
        Catch ex As System.Exception
            eErrSts = ERR.EXCEPTION
            XLW.DebugException(ex)
            bOK = False
        End Try
        Return oRet
    #End If
    End Function
    '// ===================================================================== '

    #If EMPTY_STUB=False
    '// --------------------------------------------------------------------- '
    'crdotlin
    'http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/e97feb56-03c6-414c-9c54-8509df9f9fd7/
    '=False (=0) not merged
    '=True (<>0) merged
    '= -1 merged and is the first cell of MergeArea
    Private Function isMerged(theCell As Excel.Range, ByRef ary() As LAYMRGD) As LAYCELL
        With theCell
            If .MergeArea.Cells.Count = 1 Then
                Return LAYCELL.ONECELL
            ElseIf  .MergeArea.Cells.Count > 1 Then
                For j As Integer = 0 to UBound(ary) - 1
                    If (.MergeArea.Address = ary(j).a) Then
                        GoTo AlreadyCached
                    End If
                Next
                Dim rng As Excel.Range = DirectCast(.MergeArea, Excel.Range)
                ary(UBound(ary)).a = .MergeArea.Address
                ary(UBound(ary)).r1 = rng.Row
                ary(UBound(ary)).c1 = rng.Column
                Dim iCell As Excel.Range
                Dim i As Integer = ary(UBound(ary)).r1 + 1
                Do
                    iCell = DirectCast( _
                        ExcelSheet.Cells(i,rng.Column), Excel.Range).MergeArea
                    i = i + 1
                Loop Until iCell.Address <> .MergeArea.Address
                ary(UBound(ary)).r2 = i-2
                i = ary(UBound(ary)).c1 + 1
                Do
                    iCell = DirectCast( _
                        ExcelSheet.Cells(rng.Row,i), Excel.Range).MergeArea
                    i = i + 1
                Loop Until iCell.Address <> .MergeArea.Address
                ary(UBound(ary)).c2 = i-2
                redim preserve ary(0 to ubound(ary)+1)

                AlreadyCached:
                If .Address =  DirectCast(.MergeArea.Cells(1), _
                    Excel.Range).Address Then
                    Return LAYCELL.HEAD
                Else
                    Return LAYCELL.MERGED
                End If
            End If
        End With
    End Function
    '// ===================================================================== '
    #End If

    '// --------------------------------------------------------------------- '
    Public Function GetLayOut( _
        ByRef sArgs As LAY) As Boolean

    #If EMPTY_STUB
        eErrSts = ERR.BADINIT
        Return False
    #Else
        If sArgs.iColCnr <= 0 then
            Debug.Print("Invalid columns count " & sArgs.iColCnr.ToString)
            Return False
        End If
        If sArgs.iRowCnt <= 0 then
            Debug.Print("Invalid rows count " & sArgs.iRowCnt.ToString)
            Return False
        End If

        ReDim sArgs.aMrg(0 to 0)
        ReDim sArgs.dWidths(0 to sArgs.iColCnr-1)
        ReDim sArgs.dHeights(0 to sArgs.iRowCnt-1)
        ReDim sArgs.cLay(0 to sArgs.iColCnr*sArgs.iRowCnt-1)
        ReDim sArgs.aAlgn(0 to sArgs.iColCnr*sArgs.iRowCnt-1)
        ReDim sArgs.dTxH(0 to sArgs.iColCnr*sArgs.iRowCnt-1)
        Dim i As Integer = 0
        Dim ii As Integer = 0
        For c As Integer = sArgs.iColStart to _
                           sArgs.iColStart+sArgs.iColCnr-1

            For r As Integer =  sArgs.iRowStart to _
                                sArgs.iRowStart+sArgs.iRowCnt-1

                sArgs.cLay(i) = _
                    isMerged(DirectCast(ExcelSheet.Cells _
                        (r, c),Excel.Range), sArgs.aMrg)
                If (sArgs.cLay(i) <> LAYCELL.MERGED) Then
                    With    DirectCast(ExcelSheet.Cells(r, c),Excel.Range)
                        sArgs.dTxH(i) = CDbl(.Font.Size)
                        Dim hrz As Excel.XlHAlign = DirectCast(.HorizontalAlignment,Excel.XlHAlign)
                        Dim vert As Excel.XlVAlign = DirectCast(.VerticalAlignment,Excel.XlVAlign)
                        Select Case hrz
                            Case Excel.XlHAlign.xlHAlignRight
                                Select Case vert
                                    Case Excel.XlVAlign.xlVAlignBottom
                                        sArgs.aAlgn(i) = ALGN.BTMRIGHT
                                    Case Excel.XlVAlign.xlVAlignTop
                                        sArgs.aAlgn(i) = ALGN.TOPRIGHT
                                    Case Else
                                        sArgs.aAlgn(i) = ALGN.MIDDLERIGHT
                                End Select
                            Case Excel.XlHAlign.xlHAlignLeft
                                Select Case vert
                                    Case Excel.XlVAlign.xlVAlignBottom
                                        sArgs.aAlgn(i) = ALGN.BTMLEFT
                                    Case Excel.XlVAlign.xlVAlignTop
                                        sArgs.aAlgn(i) = ALGN.TOPLEFT
                                    Case Else
                                        sArgs.aAlgn(i) = ALGN.MIDDLELEFT
                                End Select
                            Case Else
                                Select Case vert
                                    Case Excel.XlVAlign.xlVAlignBottom
                                        sArgs.aAlgn(i) = ALGN.BTMCENTER
                                    Case Excel.XlVAlign.xlVAlignTop
                                        sArgs.aAlgn(i) = ALGN.TOPCENTER
                                    Case Else
                                        sArgs.aAlgn(i) = ALGN.MIDDLECENTER
                                End Select
                        End Select
                    End With
                Else
                    sArgs.aAlgn(i)= ALGN.MIDDLECENTER
                End If
                i = i + 1
            Next
            sArgs.dWidths(ii) = CDbl(DirectCast(ExcelSheet.Columns(c),Excel.Range).ColumnWidth) * 7.5
            ii = ii + 1
        Next
        i = 0
        For r As Integer =  sArgs.iRowStart to _
                            sArgs.iRowStart+sArgs.iRowCnt-1

            sArgs.dHeights(i) = CDbl(DirectCast(ExcelSheet.Rows(r),Excel.Range).RowHeight) * 1.33333333334
            i = i + 1
        Next

        If UBound(sArgs.aMrg) = 0 Then
            ReDim sArgs.aMrg(-1)
        Else
            ReDim Preserve sArgs.aMrg (0 to UBound(sArgs.aMrg) - 1)
            For i = 0 to UBound(sArgs.aMrg)
                If sArgs.aMrg(i).c1 < sArgs.iColStart Then
                    sArgs.aMrg(i).c1 = sArgs.iColStart
                End If
                If sArgs.aMrg(i).r1 < sArgs.iRowStart Then
                    sArgs.aMrg(i).r1 = sArgs.iRowStart
                End If
                If sArgs.aMrg(i).c2 > sArgs.iColStart + sArgs.iColCnr - 1 Then
                    sArgs.aMrg(i).c2 = sArgs.iColStart + sArgs.iColCnr - 1
                End If
                If sArgs.aMrg(i).r2 > sArgs.iRowStart + sArgs.iRowCnt - 1 Then
                    sArgs.aMrg(i).r2 = sArgs.iRowStart + sArgs.iRowCnt - 1
                End If
            Next
        End If
        return true
    #End If
    End Function
    '// ===================================================================== '

    '// --------------------------------------------------------------------- '
	Public Sub GetRangeContent( _
        ByVal r As Integer, _
        ByVal c As Integer, _
        ByVal rCnt As Integer, _
        ByVal cCnt As Integer, _
		ByRef sOut() as String)
    #If EMPTY_STUB=True
		Return
	#Else
		Debug.Print("GetRangeContent")
		Dim k as Integer = rCnt*cCnt
		If (k <= 0) Then Return
		Redim sOut(0 to k-1)
		Debug.Print("Redim ok")
		k = 0
		For i as Integer = r to r+rCnt-1
		For j as Integer = c to c+cCnt-1
			Debug.Print("Row " & i.ToString() & " Column " & j.ToString())
			sOut(k) = GetCVStr(i,j)
            k = k + 1
		Next j
		Next i
    #End If
    End Sub
    '// ===================================================================== '
	
	
End Class
'//  CLASS    =============================================================== '
'//
'//
'//
'//
'//  FUNCTIONS    ----------------------------------------------------------- '

'//  FUNCTIONS    =========================================================== '
'//
'//
'//
'//
'// ------------------------------------------------------------------------- '
'// ========================================================================= '
